ftp.mactech.com 2010/ftp.mactech.com.tar/ftp.mactech.com/machack/Hacks96/ObiWanDCMDSourceDist.sit/ObiWan DCMD Source Dist/ObiWanDcmd.p

Text File | 1996-06-22 | 4KB | 171 lines

unit GrabbugDcmd;

(* ©1996 Quinn "The Eskimo!" *)
(* This file is distributed as Freeware. *)

interface

    uses
        Types,
        TextUtils,
        Files,
        GestaltEqu,
        Errors,
        (* for some reason all UPI uses must go before Dcmd.p  *sigh* *)
        Dcmd,

        LineTypes;

    procedure CommandEntry (paramPtr: dcmdBlockPtr);

implementation

    const
        obiWanNotFoundErr = -666;
        fsBusyErr = -667;
        olReentryErr = -668;
        olNotFound = -669;

    const
        ol_find_exhaustive = 1;
        ol_next_exhaustive = 2;
        ol_find = 3;
        ol_next = 4;

    function DecStr(l : longint) : Str15;
        var
            tmp : packed array [0..9] of char;
            res : Str15;
            negative : Boolean;
            b : longint;
    begin
        tmp := '0123456789';
        negative := (l < 0);
        l := abs(l);
        repeat
            b := l mod 10;
            res := concat(chr(b + ord('0')), res);
            l := l div 10;
        until l = 0;
        if negative then begin
            res := concat('-', res);
        end; (* if *)
        DecStr := res;
    end; (* DecStr *)

    function CallLookupProc(cmd : longint; key : Str255; var count : longint; var result : linesArray; proc : ProcPtr) : OSErr;
    inline
        $205F, (* move.l    (a7)+,a0        ; pop proc address    *)
        $4E90; (* jsr            (a0)                ; call proc                    *)

    const
        FSBusy = $360;

    function DoObiWanLookup(exhaustive : Boolean; key : Str255) : OSErr;
        var
            err : OSErr;
            cmd : longint;
            lookup_proc : ProcPtr;
            done : Boolean;
            line : longint;
            count : longint;
            result : linesArray;
            junk_char : char;
            printed_something : Boolean;
    begin
        err := noErr;
        if Ptr(FSBusy)^ <> 0 then begin
            err := fsBusyErr;
        end; (* if *)
        if err = noErr then begin
            err := Gestalt('OB1K', longint(lookup_proc));
            if (err <> noErr) or (lookup_proc = nil) then begin
                err := obiWanNotFoundErr;
            end; (* if *)
        end; (* if *)

        if err = noErr then begin
            if exhaustive then begin
                dcmdDrawLine(concat('ObiWan exhaustive search for “', key, '”...'));
            end else begin
                dcmdDrawLine(concat('ObiWan find “', key, '”...'));
            end; (* if *)
            cmd := ord(not exhaustive) * 2 + 1;
            printed_something := false;
            repeat
                err := CallLookupProc(cmd, key, count, result, lookup_proc);
                if err = noErr then begin
                    printed_something := true;
                    dcmdDrawLine('');
                    for line := 1 to count do begin
                        dcmdDrawLine(result[line]);
                    end; (* for *)
                    done := not dcmdDrawPrompt('Press Return to search for next.');
                    cmd := ord(not exhaustive) * 2 + 2;
                end else if err = olNotFound then begin
                    if not printed_something then begin
                        dcmdDrawLine('... nothing found.');
                    end; (* if *)
                    done := true;
                    err := noErr;
                end; (* if *)
            until (err <> noErr) or done;
        end; (* if *)

        DoObiWanLookup := err;
    end; (* DoObiWanLookup *)

    procedure CommandEntry (paramPtr: dcmdBlockPtr);
        var
            err : OSErr;
            text : Str255;
            junk_char : char;
            exhaustive : Boolean;
    begin
        err := noErr;
        case paramPtr^.request of
            dcmdSecondaryInit :
                ;
            dcmdShutdown :
                ;
            dcmdDoIt :
                begin
                    exhaustive := false;
                    junk_char := dcmdGetNextParameter(text);
                    if copy(text, 1, 2) = '-s' then begin
                        exhaustive := true;
                        junk_char := dcmdGetNextParameter(text);
                    end; (* if *)
                    err := DoObiWanLookup(exhaustive, text);
                end;
            dcmdHelp :
                begin
                    dcmdDrawLine('ObiWan [-shift] text');
                    dcmdDrawLine('  Display ObiWan entry for text.');
                end;
            dcmdGetInfo :
                begin
                    GetInfoRequestBlockPtr(paramPtr^.requestIOBlock)^.usageStr := '';
                    GetInfoRequestBlockPtr(paramPtr^.requestIOBlock)^.creditsStr := '©1996 Quinn "The Eskimo!"';
                    GetInfoRequestBlockPtr(paramPtr^.requestIOBlock)^.dcmdVersion.majorRev := $01;
                    GetInfoRequestBlockPtr(paramPtr^.requestIOBlock)^.dcmdVersion.minorAndBugRev := $00;
                    GetInfoRequestBlockPtr(paramPtr^.requestIOBlock)^.dcmdVersion.stage := betaStage;
                    GetInfoRequestBlockPtr(paramPtr^.requestIOBlock)^.dcmdVersion.nonRelRev := $01;
                end;
        otherwise
            (* do nothing *)
        end; (* case *)
        if err <> noErr then begin
            if err = obiWanNotFoundErr then begin
                dcmdDrawLine('ObiWan is not running.');
            end else if err = fsBusyErr then begin
                dcmdDrawLine('ObiWan cannot run because the file system is busy.');
            end else if err = olReentryErr then begin
                dcmdDrawLine('ObiWan cannot run because ObiWan is busy.');
            end else begin
                dcmdDrawLine(concat('ObiWan error ', DecStr(err), '.'));
            end; (* if *)
        end; (* if *)
    end; (* CommandEntry  *)

end. (* GrabbugDcmd *)